home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / bbs / tdk_v136.zip / CRCUNIT.PAS < prev    next >
Pascal/Delphi Source File  |  1997-08-16  |  5KB  |  144 lines
  1. {
  2.  ▀▀▀▀▀▀▀▀  ▀▀▀▀▀▀    ▀▀   ▀▀
  3.    ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  4.   ▀▀     ▀▀   ▀▀▀  ▀▀▀▀▀  The DoorKit!
  5.  ▀▀     ▀▀   ▀▀   ▀▀  ▀▀
  6. ▀▀     ▀▀▀▀▀▀    ▀▀    ▀▀
  7. The BBS Door Development Kit By The People - For The People!
  8.  
  9.  
  10.    Feel free to modify or optimize this code at will. All I ask is that if
  11.    find a better way to do things (and you will), please send me a copy of
  12.    your modifications. Thanks in advance!....Larry L. Athey....
  13.  
  14.    This unit is used for calculating the 32 Bit CRC value of strings and
  15.    files. This is especially handy for creating resource files for MAX
  16.    compatible doors with unique names. Using the CRC32 value of a file
  17.    for its file name prevents the possibility of display errors and also
  18.    prevents two identical files with different file names.                      }
  19.  
  20.  
  21. {$A+,B-,D+,E+,F+,G+,I-,L+,N-,O+,P-,Q-,R-,S-,T-,V+,X+}
  22. UNIT CRCUNIT;
  23.  
  24. INTERFACE
  25.  
  26. FUNCTION FileToCRC(FName : STRING) : STRING;
  27. FUNCTION StringToCRC(InStr : STRING) : STRING;
  28.  
  29. IMPLEMENTATION
  30.  
  31. CONST Crc_32_Tab: ARRAY[0..255] OF LONGINT = (
  32. $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, $706af48f, $e963a535, $9e6495a3,
  33. $0edb8832, $79dcb8a4, $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, $90bf1d91,
  34. $1db71064, $6ab020f2, $f3b97148, $84be41de, $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7,
  35. $136c9856, $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, $fa0f3d63, $8d080df5,
  36. $3b6e20c8, $4c69105e, $d56041e4, $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b,
  37. $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, $45df5c75, $dcd60dcf, $abd13d59,
  38. $26d930ac, $51de003a, $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, $b8bda50f,
  39. $2802b89e, $5f058808, $c60cd9b2, $b10be924, $2f6f7c87, $58684c11, $c1611dab, $b6662d3d,
  40. $76dc4190, $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, $9fbfe4a5, $e8b8d433,
  41. $7807c9a2, $0f00f934, $9609a88e, $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01,
  42. $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, $1b01a57b, $8208f4c1, $f50fc457,
  43. $65b0d9c6, $12b7e950, $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, $fbd44c65,
  44. $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb,
  45. $4369e96a, $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, $aa0a4c5f, $dd0d7cc9,
  46. $5005713c, $270241aa, $be0b1010, $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f,
  47. $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, $2eb40d81, $b7bd5c3b, $c0ba6cad,
  48. $edb88320, $9abfb3b6, $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, $73dc1683,
  49. $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1,
  50. $f00f9344, $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, $196c3671, $6e6b06e7,
  51. $fed41b76, $89d32be0, $10da7a5a, $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5,
  52. $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, $a6bc5767, $3fb506dd, $48b2364b,
  53. $d80d2bda, $af0a1b4c, $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, $4669be79,
  54. $cb61b38c, $bc66831a, $256fd2a0, $5268e236, $cc0c7795, $bb0b4703, $220216b9, $5505262f,
  55. $c5ba3bbe, $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, $2cd99e8b, $5bdeae1d,
  56. $9b64c2b0, $ec63f226, $756aa39c, $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713,
  57. $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, $e5d5be0d, $7cdcefb7, $0bdbdf21,
  58. $86d3d2d4, $f1d4e242, $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, $18b74777,
  59. $88085ae6, $ff0f6a70, $66063bca, $11010b5c, $8f659eff, $f862ae69, $616bffd3, $166ccf45,
  60. $a00ae278, $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, $4969474d, $3e6e77db,
  61. $aed16a4a, $d9d65adc, $40df0b66, $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9,
  62. $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, $cdd70693, $54de5729, $23d967bf,
  63. $b3667a2e, $c4614ab8, $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, $2d02ef8d
  64. );
  65.  
  66. FUNCTION UpdC32(Octet : BYTE ; Crc : LONGINT) : LONGINT;
  67. BEGIN
  68.   UpdC32 := Crc_32_Tab[BYTE(Crc XOR LONGINT(Octet))] XOR ((Crc SHR 8) AND $00FFFFFF);
  69. END;
  70.  
  71. FUNCTION CrcString(I : LONGINT) : STRING; Assembler;
  72. asm
  73.   jmp    @1
  74.   @0 :
  75.   db     '0123456789abcdef'
  76.   @1 :
  77.   cld
  78.   les    di, @result
  79.   mov    ax, 0008h
  80.   stosb
  81.   mov    cx, 4
  82.   mov    si, 3
  83.   @2 :
  84.   mov    al, BYTE [I + si]
  85.   DEC    si
  86.   push   si
  87.   mov    bl, al
  88.   mov    dl, bl
  89.   AND    bx, 00f0h
  90.   SHR    bx, 4
  91.   AND    dx, 000fh
  92.   mov    si, bx
  93.   mov    al, BYTE [cs : @0 + si]
  94.   stosb
  95.   mov    si, dx
  96.   mov    al, BYTE [cs : @0 + si]
  97.   stosb
  98.   pop    si
  99.   loop   @2
  100. END;
  101.  
  102. FUNCTION StringCRC(InStr : STRING) : LONGINT;
  103. VAR
  104.   CrcVal : LONGINT;
  105.   A      : WORD;
  106. BEGIN
  107.   CrcVal := $FFFFFFFF;
  108.   FOR A := 1 TO LENGTH(InStr) DO CrcVal := UpdC32(ORD(InStr[A]),CrcVal);
  109.   StringCRC := CrcVal;
  110. END;
  111.  
  112. FUNCTION CrcEnd(Crc : LONGINT) : LONGINT;
  113. BEGIN
  114.   CrcEnd := Crc XOR $ffffffff;
  115. END;
  116.  
  117. FUNCTION FileToCRC(FName : STRING) : STRING;
  118. VAR
  119.   Crc  : LONGINT;
  120.   F    : FILE;
  121.   Buf  : ARRAY[1..1024] OF BYTE;
  122.   Nr,N : WORD;
  123. BEGIN
  124.   ASSIGN(F,FName);
  125.   RESET(F,1);
  126.   IF IORESULT = 0 THEN BEGIN
  127.     Crc := $ffffffff;
  128.     REPEAT
  129.       BLOCKREAD(F,Buf,SIZEOF(Buf),Nr);
  130.       FOR N := 1 TO Nr DO Crc := UpdC32(Buf[N],Crc);
  131.     UNTIL Nr = 0;
  132.     CLOSE(F);
  133.     Crc       := CrcEnd(Crc);
  134.     FileToCRC := CrcString(Crc);
  135.   END ELSE FileToCRC := '';
  136. END;
  137.  
  138. FUNCTION StringToCRC(InStr : STRING) : STRING;
  139. BEGIN
  140.   StringToCRC := CrcString(StringCrc(InStr));
  141. END;
  142.  
  143. END.
  144.